Loadstar 94

home *** CD-ROM | disk | FTP | other *** search

/ Loadstar 94 / 094.d81 / source.sda / BIG BOX SOURCE < prev next >

Wrap

Text File | 1992-01-01 | 11.6 KB | 1,272 lines

open =$ffc0 readst =$ffb7 setlfs =$ffba setnam =$ffbd setmsg =$ff90 load =$ffd5 getin =$ffe4 input'buffer =512 clrchn =$ffcc close =$ffc3 ;a chrin =$ffcf chkout =$ffc9 ;x chkin =$ffc6 ;x plot =$fff0 chrout =$ffd2 color'pointer =243 screen'line'pointer =209 print'number =$bdcd ;x,a clear'line =59903 background =53281 border =53280 strout = $ab1e; .A low .Y high unlisten =$ffae clall =$ffe7 color1 =53282 color2 =53283 color3 =53284 white =5 crsr'down =17 rvs'on =18 home =19 del =20 red =28 crsr'right =29 green =30 blue =31 black =144 lowercase =14 uppercase =142 crsr'up =145 rvs'off =146 clr =147 insert =148 brown =149 light'red =150 dark'grey =151 medium'grey =152 light'green =153 light'blue =154 light'grey =155 purple =156 crsr'left =157 yellow =158 cyan =159 top'left =176 top'right =174 bottom'left =173 bottom'right =189 .org $c000 .obj "@0:big box c000" ;mem jmp menu'entry jmp box'entry ; +3 jmp screen'stash; +6 jmp screen'restore; +9 jmp linx; +12 jmp print'at; +15 jmp center; +18 jmp ucase; +21 jmp lcase; +24 jmp fcase; +27 jmp bload; +30 jmp rload; +33 jmp pfill; +36 jmp p2fill; +39 jmp brancher; +42 jmp bput; +45 jmp rbput; +48 jmp dir; +51 jmp doodle; +54 jmp reader; +57 jmp char'repeat; +60 ;***sys addr,x,to x,y,to y,s-code,color box'entry lda #0 sta temp - jsr get'number ldy temp sta parms,y inc temp cpy #5 bne - fill'box jsr linx lda 214 pha lda 211 pha box'start ldx parms+2 ldy #0 clc jsr $fff0 jsr old'rom'patch dec parms - ldy parms+1 - lda parms+4 cmp #255 beq + sta (209),y + lda parms+5 sta (243),y dey cpy parms bne - lda 214 cmp parms+3 beq + inc 214 jsr 58732 jsr old'rom'patch jmp -- + lda #home jsr $ffd2 pla sta 211 pla sta 214 jmp 58732 linx ldy #24 - lda 217,y ora #128 sta 217,y dey bpl - rts screen'stash sec jsr plot stx menuy sty menux1 jsr get'number sta 252 cmp >1024 bcs + rts + clc adc #4 sta 254 lda #0 sta 253 sta 251 lda #home jsr chrout jsr old'rom'patch sei lda #0 sta 1 ldx #3 ldy #0 - lda (209),y sta (251),y dec 1 lda (243),y inc 1 sta (253),y iny bne - inc 210 inc 252 inc 244 inc 254 dex bpl - dec 254 ldy #233 dec 1 lda 53280 inc 1 sta (253),y iny dec 1 lda 53281 inc 1 sta (253),y iny lda menuy sta (253),y iny lda menux1 sta (253),y lda #$77 sta 1 cli ldy menux1 ldx menuy clc jmp plot screen'restore jsr get'number sta 252 clc adc #4 sta 254 lda #0 sta 253 sta 251 lda #home jsr chrout jsr old'rom'patch sei lda #0 sta 1 ldx #3 ldy #0 - lda (251),y sta (209),y lda (253),y dec 1 sta (243),y inc 1 iny bne - inc 210 inc 252 inc 244 inc 254 dex bpl - dec 254 ldy #233 lda (253),y dec 1 sta 53280 iny inc 1 lda (253),y dec 1 sta 53281 inc 1 iny lda (253),y sta 214 iny lda (253),y sta 211 lda #$77 sta 1 cli jmp 58732 menu'entry lda #0 sta temp sta flag - jsr get'number ldy temp sta menuy,y inc temp cpy #6 bne - menu jsr linx ldx menuy ldy #0 sty menu'current clc jsr plot jsr old'rom'patch lda menu'highlight sta mcolor jsr paint'line menu'wait jsr getin beq menu'wait ldx menu'current stx temp cmp #crsr'down beq menu'down cmp #crsr'up beq menu'up cmp #13 beq menu'select cmp exit'key bne menu'wait'loop dec flag bmi menu'select menu'wait'loop jmp menu'wait menu'down inc menu'current lda menu'current cmp menu'items bne highlight lda #0 sta menu'current jmp highlight menu'up dec menu'current lda menu'current cmp #255 beq + jmp highlight + ldy menu'items dey sty menu'current jmp highlight menu'select lda menu'current clc adc menuy tax ldy #0 jsr plot jsr old'rom'patch lda menu'text sta mcolor jsr paint'line bit flag bmi + lda menu'current clc adc #49 sta 631 lda #1 sta 198 + rts highlight lda menuy clc adc menu'current tax ldy #0 clc jsr plot jsr old'rom'patch lda menu'highlight sta mcolor jsr paint'line lda menuy clc adc temp tax ldy #0 clc jsr plot jsr old'rom'patch lda menu'text sta mcolor jsr paint'line jmp menu'wait paint'line ldy menux1 - lda mcolor sta (243),y bmi + lda (209),y eor #128 sta (209),y + iny cpy menux2 beq - bcc - rts ;**** get number from BASIC **** get'number jsr $aefd jsr $ad8a jsr $b7f7 lda $14 ; got low byte rts ;***** get string from BASIC **** get'string jsr $aefd jsr $ad9e jsr $b6a3 ldx $22 ldy $23 rts print'at jsr linx jsr get'number sta 211 jsr get'number sta 214 jsr 58732 jsr get'string sta temp print'string ldy #0 - lda ($22),y jsr chrout iny cpy temp bne - rts ucase jsr get'string sta temp ldy #0 - lda ($22),y cmp #65 bcc + ora #128 sta ($22),y + iny cpy temp bne - rts lcase jsr get'string sta temp ldy #0 - lda ($22),y and #127 sta ($22),y iny cpy temp bne - rts fcase lda #255 sta flag jsr get'string sta temp ldy #0 lda ($22),y cmp #65 bcc + ora #128 sta ($22),y + iny lda #0 sta flag ldy #1 - lda ($22),y and #127 sta ($22),y cmp "." bne + dec flag + cmp "!" bne + dec flag + cmp "?" bne + dec flag + bit flag bmi + iny cpy temp bne - rts + cmp #65 bcc + ora #128 sta ($22),y inc flag + iny cpy temp bne - rts center jsr get'number tax ldy #0 clc jsr plot jsr get'string sta temp lsr sta flag lda #20 sec sbc flag sta 211 jsr 58732 jmp print'string bload jsr get'string jsr setnam jsr get'number tax lda #1 ldy #0 jsr setlfs jsr get'number ldx $14 ldy $15 lda #0 jmp load rload jsr get'string jsr setnam jsr get'number tax lda #2 ldy #2 jsr setlfs jsr open jsr get'number jsr clrchn ldx #2 jsr chkin ldy #0 - jsr getin sei ldx #$74 stx 1 sta ($14),y inc $14 bne + inc $15 + ldx #$77 stx 1 cli jsr readst and #64 beq - lda #2 jsr close jmp clrchn pfill lda #0 sta temp - jsr get'number ldy temp sta parms,y inc temp cpy #7 bne - pfill'box jsr linx lda 214 pha lda 211 pha pbox'start lda #147 jsr chrout jsr old'rom'patch ldy #0 sty temp - ldy #0 - lda parms sta (209),y lda parms+4 sta (243),y iny lda parms+1 sta (209),y lda parms+5 sta (243),y dey jsr q3 iny iny cpy #39 bcc - lda 214 cmp #22 bcs + inc 214 inc 214 jsr 58732 jsr old'rom'patch jmp -- + jsr fix'bottom pla sta 211 pla sta 214 jmp 58732 q3 lda 209 clc adc #40 sta 251 lda #0 adc 210 sta 252 lda 243 clc adc #40 sta 253 lda 244 adc #0 sta 254 lda parms+2 sta (251),y lda parms+6 sta (253),y iny lda parms+3 sta (251),y lda parms+7 sta (253),y dey rts fix'bottom lda #22 sta 214 jsr 58732 jsr old'rom'patch lda 209 clc adc #80 sta 251 lda #0 adc 210 sta 252 lda 243 clc adc #80 sta 253 lda #0 adc 244 sta 254 ldy #39 - lda (209),y sta (251),y lda (243),y sta (253),y dey bpl - rts p2fill lda #0 sta temp - jsr get'number ldy temp sta parms,y inc temp cpy #17 bne - p2fill'box jsr linx lda 214 pha lda 211 pha p2box'start lda #147 jsr chrout jsr old'rom'patch ldy #0 sty temp - ldy #0 - lda parms sta (209),y lda parms+9 sta (243),y iny lda parms+1 sta (209),y lda parms+10 sta (243),y iny lda parms+2 sta (209),y lda parms+11 sta (243),y dey dey jsr q4 iny iny iny cpy #37 bcc - lda 214 cmp #21 bcs + inc 214 inc 214 inc 214 jsr 58732 jsr old'rom'patch jmp -- + jsr fix'side pla sta 211 pla sta 214 jmp 58732 q4 lda 209 clc adc #40 sta 251 lda #0 adc 210 sta 252 lda 243 clc adc #40 sta 253 lda 244 adc #0 sta 254 lda parms+3 sta (251),y lda parms+12 sta (253),y iny lda parms+4 sta (251),y lda parms+13 sta (253),y iny lda parms+5 sta (251),y lda parms+14 sta (253),y dey dey lda 251 clc adc #40 sta 251 lda #0 adc 252 sta 252 lda 253 clc adc #40 sta 253 lda 254 adc #0 sta 254 lda parms+6 sta (251),y lda parms+15 sta (253),y iny lda parms+7 sta (251),y lda parms+16 sta (253),y iny lda parms+8 sta (251),y lda parms+17 sta (253),y dey dey rts fix'side lda #19 jsr chrout jsr old'rom'patch - ldy #0 lda (209),y tax lda (243),y ldy #39 sta (243),y txa sta (209),y lda 214 cmp #24 beq + inc 214 jsr 58732 jsr old'rom'patch jmp - + lda #21 sta 214 jsr 58732 jsr old'rom'patch lda 209 clc adc #120 sta 251 lda #0 adc 210 sta 252 lda 243 clc adc #120 sta 253 lda #0 adc 244 sta 254 ldy #39 - lda (209),y sta (251),y lda (243),y sta (253),y dey bpl - rts brancher lda #0 sta flag jsr get'string sta temp - jsr getin beq - ldy #0 - cmp ($22),y bne + iny tya clc adc #48 sta 631 lda #9 sta 198 rts + iny cpy temp bne - beq -- bput jsr get'string jsr setnam jsr get'number tax lda #1 ldy #1 jsr setlfs jsr open jsr get'number sta 251 lda $15 sta 252 jsr get'number sta 249 lda $15 sta 250 jsr clrchn ldx #1 jsr chkout lda 251 jsr chrout lda 252 jsr chrout bsave ldy #0 - sei ldx #$74 stx 1 lda (251),y inc 251 bne + inc 252 + ldx #$77 stx 1 cli jsr chrout lda 252 cmp 250 bcc - lda 251 cmp 249 bcc - lda #1 jsr close jmp clrchn rbput jsr get'string jsr setnam jsr get'number tax lda #1 ldy #1 jsr setlfs jsr open jsr get'number sta 251 lda $15 sta 252 jsr get'number sta 249 lda $15 sta 250 jsr clrchn ldx #1 jsr chkout jsr get'number jsr chrout lda $15 jsr chrout jmp bsave dir jsr get'string jsr setnam jsr get'number sta device lda #17; file number ldx device ldy #0 jsr $ffba; n setlfs jsr $ffc0; open ldx #17 jsr $ffc6; jsr get'byte jsr get'byte; skip first two bytes first jsr $ffb7; read status and #64 bne dir'out jsr get'byte jsr get'byte; skip two bytes second jsr $ffb7 and #64; eof? bne dir'out jsr get'byte tax jsr get'byte jsr $bdcd lda " " jsr $ffd2 jsr $ffb7 and #64; eof? bne dir'out third jsr get'byte bne + lda #13 jsr $ffd2 jmp first + jsr $ffd2 jsr $ffb7 and #64 bne dir'out jmp third get'byte jsr $ffcf; chrin rts dir'out lda #17 jsr $ffc3; close17 jsr $ffcc ;clear chan rts ;sys,name,device,font location doodle jsr get'string jsr setnam jsr get'number sta device jsr get'number sta 251 lda $15 sta 252 ldx device lda #1 ldy #1 jsr setlfs jsr open ldx #1 jsr chkout lda #3 sta count lda <23552 jsr chrout lda >23552 jsr chrout ldy #0 ldx #0 lda <$d800 sta 253 lda >$d800 sta 254 lda #3 sta count ldy #0 - lda (253),y and #15 asl asl asl asl sta temp lda 53280 and #15 ora temp jsr chrout iny bne - inc 254 dec count bpl - bitmap lda 648 sta 254 lda #0 sta 253 lda #0 sta row lda #24 sta count ldy #0 - lda 251 sta 249 lda 252 sta 250 lda #0 sta add sta add+1 lda (253),y sta temp sta add sty tempy jsr bitmap'math ldy tempy iny cpy #40 bne - ldy #0 clc lda #40 adc 253 sta 253 lda #0 adc 254 sta 254 dec count bpl - ldy #191 - jsr chrout dey cpy #255 bne - lda #1 jsr close jmp clrchn bitmap'math lda #0 sta add+1 lda temp sta add asl add bcc + inc add+1 + asl add+1 asl add bcc + lda #1 ora add+1 sta add+1 + asl add+1 asl add bcc + lda #1 ora add+1 sta add+1 + clc lda add adc 251 sta 249 lda add+1 adc 252 sta 250 ldy #0 - sei ldx #$74 stx 1 lda (249),y ldx #$77 stx 1 cli jsr chrout iny cpy #8 bcc - rts reader lda #147 jsr chrout jsr get'string jsr setnam jsr get'number tax lda #2 ldy #2 jsr setlfs jsr open ldx #2 jsr chkin - jsr getin jsr chrout sta 251 jsr readst and #64 bne eof lda 251 cmp #13 bne - lda 214 cmp #22 bcc - ldx #24 ldy #6 clc jsr plot inc 199 ldy >text lda <text jsr strout jsr clrchn - jsr getin beq - cmp " " bne + lda #147 jsr chrout ldx #2 jsr chkin jmp -- + cmp "q" bne - - lda #2 jsr close jmp clrchn eof jsr clrchn - jsr getin beq - jmp -- char'repeat jsr get'number sta add lda $15 sta add+1 jsr get'string sta temp - ldy #0 - lda ($22),y jsr chrout iny cpy temp bne - dec add lda add cmp #255 bne -- dec add+1 lda add+1 cmp #255 bne -- rts old'rom'patch lda 210 sec sbc 648 clc adc #$d8 sta 244 lda 209 sta 243 rts text .asc " SPACE - Continue Q - Quit ":.byt 19,13,159,0 tempy .byt 0 add .word 0 count .byt 0 row .byt 0 menuy .byt 0 menux1 .byt 0 menux2 .byt 0 menu'items .byt 0 menu'text .byt 0 menu'highlight .byt 0 exit'key .byt 0 menu'current .byt 0 mcolor .byt 0 device .byt 0 parms .buf 20 x1 .byt 0 x2 .byt 0 y1 .byt 0 y2 .byt 0 screen'code .byt 0 box'color .byt 0 flag .byt 0 temp .byt 0